home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TSPA3470 / TSUNTB.TST < prev    next >
Text File  |  1993-01-22  |  6KB  |  295 lines
  1. (* This is a test program for the TSUNTB.TPU unit
  2.    Updated 27-Jul-89, 18-Oct-89, 4-Jan-91, 27-Oct-91, 24-Aug-92,
  3.            27-Sep-92, 23-Jan-93 *)
  4.  
  5. uses TSUNTB;
  6.  
  7. const loop = 200;   (* If you do want to make it quickly, change this to 1 *)
  8.  
  9. var time : real;    (* For timing the tests *)
  10.  
  11. procedure LOGO;
  12. begin
  13.   writeln;
  14.   writeln ('TSUNTB unit test by Prof. Timo Salmi');
  15.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  16. {$IFDEF VER40}
  17.   writeln ('TP version 4.0');
  18. {$ENDIF}
  19. {$IFDEF VER50}
  20.   writeln ('TP version 5.0');
  21. {$ENDIF}
  22. {$IFDEF VER55}
  23.   writeln ('TP version 5.5');
  24. {$ENDIF}
  25. {$IFDEF VER60}
  26.   writeln ('TP version 6.0');
  27. {$ENDIF}
  28. {$IFDEF VER70}
  29.   writeln ('TP version 7.0');
  30. {$ENDIF}
  31.   writeln;
  32. end;
  33.  
  34. (* Raise a positive number to a power the traditional way *)
  35. procedure TEST1;
  36. var i : integer;
  37.     a : real;
  38. begin
  39.   time := TIMERFN;
  40.   for i := 1 to loop do
  41.     a := POWERFN (2, 15);
  42.   time := TIMERFN - time;
  43.   writeln ('POWERFN 2^15 = ', a:0:0);
  44.   writeln ('Elapsed ', time:0:2);
  45.   writeln;
  46. end;
  47.  
  48. (* Raise a longint number to a power fast *)
  49. procedure TEST1A;
  50. var i : integer;
  51.     a : real;
  52. begin
  53.   time := TIMERFN;
  54.   for i := 1 to loop do
  55.     a := POWERLFN (-2, 15);
  56.   time := TIMERFN - time;
  57.   writeln ('POWERLFN -2^15 = ', a:0:0);
  58.   writeln ('Elapsed ', time:0:2);
  59.   writeln;
  60. end;  (* test1a *)
  61.  
  62. (* Raise any number to a power, the improved function *)
  63. procedure TEST2;
  64. var i : integer;
  65.     a : real;
  66. begin
  67.   time := TIMERFN;
  68.   for i := 1 to loop do
  69.     a := POWERGFN (-2, 15);
  70.   time := TIMERFN - time;
  71.   writeln ('POWERGFN -2^15 = ', a:0:0);
  72.   writeln ('Elapsed ', time:0:2);
  73.   writeln;
  74. end;  (* test2 *)
  75.  
  76. (* Raise two to a power, that is 2^exponent, very fast *)
  77. procedure TEST3;
  78. var i : integer;
  79.     a : word;
  80. begin
  81.   time := TIMERFN;
  82.   for i := 1 to loop do
  83.     a := TWOTOFN (15);
  84.   time := TIMERFN - time;
  85.   writeln ('TWOTOFN 2^15 = ', a);
  86.   writeln ('Elapsed ', time:0:2);
  87.   writeln;
  88. end;  (* test3 *)
  89.  
  90. (* Convert a binary string fast to a decimal word *)
  91. procedure TEST4;
  92. var i : integer;
  93.     a : word;
  94. begin
  95.   time := TIMERFN;
  96.   for i := 1 to loop do
  97.                    {123456789 123456}
  98.     a := BINDECFN ('1000000000000000');
  99.   time := TIMERFN - time;
  100.   writeln ('BINDECFN (''1000000000000000'') = ', a);
  101.   writeln ('Elapsed ', time:0:2);
  102.   writeln;
  103. end;  (* test4 *)
  104.  
  105. (* Convert a decimal word to a binary string fast *)
  106. procedure TEST5A;
  107. const x = 32768;
  108. var i : integer;
  109.     a : string;
  110. begin
  111.   time := TIMERFN;
  112.   for i := 1 to loop do
  113.     a := BINFN (x);
  114.   time := TIMERFN - time;
  115.   writeln ('BINFN (', x:0, ') = ', a);
  116.   writeln ('Elapsed ', time:0:2);
  117.   writeln;
  118. end;  (* test5a *)
  119.  
  120. (* Convert a decimal longint to a binary string fast *)
  121. procedure TEST5B;
  122. var i : integer;
  123.     a : string;
  124.     x : longint;
  125. begin
  126.   x := 32768;
  127.   time := TIMERFN;
  128.   for i := 1 to loop do
  129.     a := LBINFN (x);
  130.   time := TIMERFN - time;
  131.   writeln ('LBINFN (', x:0, ') = ', a);
  132.   writeln ('Elapsed ', time:0:2);
  133.   writeln;
  134. end;  (* test5b *)
  135.  
  136. (* Convert a decimal byte to a binary string fast *)
  137. procedure TEST5C;
  138. var i : integer;
  139.     a : string;
  140.     x : longint;
  141. begin
  142.   x := 255;
  143.   time := TIMERFN;
  144.   for i := 1 to loop do
  145.     a := BBINFN (x);
  146.   time := TIMERFN - time;
  147.   writeln ('BBINFN (', x:0, ') = ', a);
  148.   writeln ('Elapsed ', time:0:2);
  149.   writeln;
  150. end;  (* test5c *)
  151.  
  152. (* Convert a number from any base to any base (2-36) *)
  153. procedure TEST6;
  154. var i      : integer;
  155.     result : string;
  156.     x      : string;
  157.     b1, b2 : byte;
  158. begin
  159.   x := '32768';
  160.   b1 := 10;
  161.   b2 := 2;
  162.   time := TIMERFN;
  163.   for i := 1 to loop do
  164.     result := CONVBFN (x, b1, b2);
  165.   time := TIMERFN - time;
  166.   writeln ('CONVBFN (', x, ',', b1:0, ',', b2:0, ') = ', result);
  167.   writeln ('Elapsed ', time:0:2);
  168.   writeln;
  169. end;  (* test6 *)
  170.  
  171. (* Convert a hexadecimal string fast to a decimal word *)
  172. procedure TEST7;
  173. var i : integer;
  174.     d : word;
  175.     h : string;
  176. begin
  177.   h := 'F1a7';
  178.   time := TIMERFN;
  179.   for i := 1 to loop do
  180.     d := HEXDECFN (h);
  181.   time := TIMERFN - time;
  182.   writeln ('HEXDECFN (', h, ') = ', d);
  183.   writeln ('Elapsed ', time:0:2);
  184.   writeln;
  185. end;  (* test7 *)
  186.  
  187. (* Convert a hexadecimal string (max 7FFFFFFF) to a decimal longint *)
  188. procedure TEST7A;
  189. var i : integer;
  190.     d : longint;
  191.     h : string;
  192. begin
  193.   h := '0000F1a7';
  194.   time := TIMERFN;
  195.   for i := 1 to loop do
  196.     d := HEXLNGFN (h);
  197.   time := TIMERFN - time;
  198.   writeln ('HEXLNGFN (', h, ') = ', d);
  199.   writeln ('Elapsed ', time:0:2);
  200.   writeln;
  201. end;  (* test7a *)
  202.  
  203. (* Convert a decimal word to a hexadecimal string fast *)
  204. procedure TEST8A;
  205. var i : integer;
  206.     a : string;
  207.     d : word;
  208. begin
  209.   d := 32768;
  210.   time := TIMERFN;
  211.   for i := 1 to loop do
  212.     a := HEXFN (d);
  213.   time := TIMERFN - time;
  214.   writeln ('HEXFN (', d:0, ') = $', a);
  215.   writeln ('Elapsed ', time:0:2);
  216.   writeln;
  217. end;  (* test8A *)
  218.  
  219. (* Convert a decimal longint to a hexadecimal string fast *)
  220. procedure TEST8B;
  221. var i : integer;
  222.     a : string;
  223.     x : longint;
  224. begin
  225.   x := maxint+1;
  226.   time := TIMERFN;
  227.   for i := 1 to loop do
  228.     a := LHEXFN (x);
  229.   time := TIMERFN - time;
  230.   writeln ('LHEXFN (', x:0, ') = $', a);
  231.   writeln ('Elapsed ', time:0:2);
  232.   writeln;
  233. end;  (* test8b *)
  234.  
  235. (* Convert a decimal byte to a hexadecimal string fast *)
  236. procedure TEST8C;
  237. var i : integer;
  238.     a : string;
  239.     x : byte;
  240. begin
  241.   x := 255;
  242.   time := TIMERFN;
  243.   for i := 1 to loop do
  244.     a := BHEXFN (x);
  245.   time := TIMERFN - time;
  246.   writeln ('BHEXFN (', x:0, ') = $', a);
  247.   writeln ('Elapsed ', time:0:2);
  248.   writeln;
  249. end;  (* test8c *)
  250.  
  251. procedure TEST9;
  252. var a : word;
  253. begin
  254.   a := BTEWRDFN (1, 2);
  255.   writeln (hi(a), ' ', lo(a));
  256.   writeln (a);
  257. end;  (* test9 *)
  258.  
  259. procedure TEST10;
  260. var a : longint;
  261. begin
  262.   a := WRDLNGFN (1, 2);
  263.   writeln (HIWORDFN(a), ' ', LOWORDFN(a));
  264.   writeln (a);
  265. end;  (* test10 *)
  266.  
  267. (* Main program
  268.    If you just want a particular test, comment the others away *)
  269. begin
  270.   LOGO;    (* If you want pauses, insert readln where appropriate *)
  271.   {        (* If you want only part of the tests, comment the others away *)
  272.   TEST1;
  273.   TEST1A;
  274.   TEST2;
  275.   TEST3;
  276.   TEST4;
  277.   }
  278.   TEST5A;
  279.   TEST5B;
  280.   TEST5C;
  281.   {
  282.   TEST6;
  283.   TEST7;
  284.   TEST7A;
  285.   }
  286.   TEST8A;
  287.   TEST8B;
  288.   TEST8C;
  289.   {
  290.   TEST9;
  291.   TEST10;
  292.   }
  293.   write ('Press <-'' '); readln;
  294. end.  (* tsuntb.tst *)
  295.